Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/tptc16.zip/FMAP.PAS

Pascal/Delphi Source File | 1993-01-04 | 6KB | 302 lines

(*
 * fmap - find symbols related to an address in a .MAP load
 *        map generated by LINK or TMAP
 *
 * S.H.Smith, 27-jan-86
 *
 *)

{$g512,p512,c-}


const
   version = 'FMAP 1.0 (1/26/87 SHS)';

type
   anystring = string[80];

var
   line:    anystring;
   fd:      text[10240];
   target:  anystring;
   mapname: anystring;


procedure abort_check;
begin
   if keypressed then
   begin
      writeln('aborted');
      halt;
   end;
end;


(* ----------------------------------------------------------------- *)
procedure parse_segments;
begin
   writeln('Segments');
   repeat
      readln(fd,line);
   until length(line) < 20;
end;


(* ----------------------------------------------------------------- *)
procedure parse_by_name;
begin
   writeln('Names');
   readln(fd,line);

   repeat
      readln(fd,line);
      abort_check;
   until length(line) < 17;
end;


(* ----------------------------------------------------------------- *)
procedure parse_by_value;
var
   pr:      anystring;
   ad:      anystring;
   ppr:     anystring;
   pad:     anystring;
   pline:   anystring;

begin
   writeln('Values');
   readln(fd,line);
   pad := '0000';
   ppr := '';

   repeat
      ad := copy(line,7,4);
      pr := copy(line,18,99);
      if (ppr <> '') and (target >= pad) and (target < ad) then
         writeln(pad,'-',ad,' ',pline);

      pad := ad;
      ppr := pr;
      pline := line;

      readln(fd,line);
      abort_check;
   until length(line) < 17;
end;


procedure output_lines(name: anystring; first, last: integer);
var
   fd: text[1024];
   n:  integer;
   b:  anystring;

begin
   writeln('Output lines ',first,'-',last,' from ',name);
   assign(fd,name);
{$i-}
   reset(fd);
{$i+}
   if ioresult <> 0 then
   begin
      writeln('can''t find source file: ',name);
      writeln('need lines ',first,'-',last);
      halt;
   end;

{$i-}
   for n := 1 to first-1 do
      readln(fd,b);

   for n := first to last+1 do
   begin
      writeln(n:6,'| ',b);
      readln(fd,b);
      abort_check;
   end;
{$i+}

   close(fd);
end;


(* ----------------------------------------------------------------- *)
var
   name:    anystring;
   ln:      integer;
   ad:      anystring;
   pln:     integer;
   pad:     anystring;
   first:   boolean;

   procedure check_match;
   begin
      writeln('   check match, ',pad,'-',ad,'  lines ',pln,'-',ln);

      if (pln <> 0) and (target >= pad) and (target < ad) then
      begin
         if first then
         begin
            writeln;
            writeln('==============================');
            writeln(name);
            first := false;
         end;

         if (ln-pln) < 20 then
         begin
            writeln('---------');
            writeln(pad,'-',ad);
            output_lines(name,pln,ln);
         end
         else
         begin
            writeln('---------');
            writeln(pad,'-',ad,'  lines ',pln,'-',ln);
         end;
      end;
   end;

procedure parse_line_numbers;
var
   i:       integer;
   code:    integer;
   buf:     anystring;

begin
   writeln('Line numbers: ',line);

   i := pos('(',line) + 1;
   name := '';
   while line[i] <> ')' do
   begin
      name := name + line[i];
      i := i + 1;
   end;

   readln(fd,line);
   writeln('name=[',name,']');

   pln := 0;
   pad := '0000';
   first := true;

   repeat
      abort_check;

      while length(line) > 6 do
      begin

         {extract the line number}
         buf := copy(line,1,5);
         while copy(buf,1,1) = ' ' do
            delete(buf,1,1);
         val(buf,ln,code);

         {extract the code address}
         ad := copy(line,12,4);

         {remove the processed part of the line}
         delete(line,1,17);

         {if target is between two lines, then print it out}
         check_match;

         pad := ad;
         pln := ln;
      end;

      readln(fd,line);
   until length(line) < 6;

   check_match;   {process the last line}
end;


(* ----------------------------------------------------------------- *)
procedure parse_others;
begin
   writeln('Other: ',line);
   readln(fd,line);
end;


(* ----------------------------------------------------------------- *)
procedure parse_mapfile;
begin
   writeln('Scanning mapfile ',mapname);
   writeln('for address ',target,':');
   writeln;

   readln(fd,line);

   while not eof(fd) do
   begin
      if copy(line,1,30) = ' Start  Stop   Length Name    ' then
         parse_segments
      else
      if copy(line,1,30) = '  Address         Publics by N' then
         parse_by_name
      else
      if copy(line,1,30) = '  Address         Publics by V' then
         parse_by_value
      else
      if copy(line,1,17) = 'Line numbers for ' then
         parse_line_numbers
      else
         parse_others;

      abort_check;
   end;

   close(fd);
end;


(* ----------------------------------------------------------------- *)
var
   i: integer;

begin
   writeln;
   writeln(version);
   writeln;

   if paramcount <> 2 then
   begin
      writeln('Usage: fmap MAPFILE TARGET_ADDRESS');
      writeln('Finds references to TARGET_ADDRESS in MAPFILE.');
      halt(1);
   end;

   mapname := paramstr(1);
   if pos('.',mapname) = 0 then
      mapname := mapname + '.MAP';

   assign(fd,mapname);
{$i-}
   reset(fd);
{$i+}
   if ioresult <> 0 then
   begin
      writeln('can''t open mapfile: ',mapname);
      halt;
   end;

   target := paramstr(2);
   for i := 1 to length(target) do
      target[i] := upcase(target[i]);

   if length(target) <> 4 then
   begin
      writeln('TARGET_ADDRESS must be 4 hex digits');
      halt;
   end;

   parse_mapfile;
   writeln;
end.